home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / FILES.SWG / 0017_View File Object.pas < prev    next >
Pascal/Delphi Source File  |  1993-06-22  |  8KB  |  247 lines
  1. { File Viewer Object  }
  2.  
  3. uses Dos, Crt;
  4.  
  5. const
  6.    PrintSet: set of $20..$7E = [ $20..$7E ];
  7.    ExtenSet: set of $80..$FE = [ $80..$FE ];
  8.    NoPrnSet: set of $09..$0D = [ $09, $0A, $0D ];
  9.  
  10. type
  11.    CharType = ( Unknown, Ascii, Hex );
  12.    DataBlock = array[1..256] of byte;
  13.    Viewer = object
  14.                XOrg, YOrg,
  15.                LineLen, LineCnt, BlockCount : integer;
  16.                FileName : string;
  17.                FileType : CharType;
  18.                procedure FileOpen( Fn : string;
  19.                                    X1, Y1, X2, Y2 : integer );
  20.                function  TestBlock( FileBlock : DataBlock;
  21.                                     Count : integer ): CharType;
  22.                procedure ListHex( FileBlock : DataBlock;
  23.                                   Count, Ofs : integer );
  24.                procedure ListAscii( FileBlock : DataBlock;
  25.                                     Count : integer );
  26.             end;
  27.  
  28.    Finder = object( Viewer )
  29.                procedure Search( Fn, SearchStr : string;
  30.                                  X1, Y1, X2, Y2 : integer );
  31.             end;
  32.  
  33. procedure Finder.Search;
  34.    var
  35.       VF : file;   Result1, Result2 : word;
  36.       BlkOfs, i, j, SearchLen : integer;
  37.       SearchArray : array[1..128] of byte;
  38.       EndFlag, BlkDone, SearchResult : boolean;
  39.       FileBlock1, FileBlock2, ResultArray : DataBlock;
  40.    begin
  41.       BlockCount := 0;
  42.       XOrg := X1;
  43.       YOrg := Y1;
  44.       LineLen := X2;
  45.       LineCnt := Y2;
  46.       FileType := Unknown;
  47.       SearchLen := ord( SearchStr[0] );
  48.       for i := 1 to Searchlen do
  49.          SearchArray[i] := ord( SearchStr[i] );
  50.       for i := 1 to sizeof( ResultArray ) do
  51.          ResultArray[i] := $00;
  52.  
  53.       assign( VF, Fn );
  54.       {$I-} reset( VF, 1 ); {$I+}
  55.       if IOresult = 0 then
  56.       begin
  57.          EndFlag := false;
  58.          BlkDone := false;
  59.          SearchResult := false;
  60.          BlockRead( VF, FileBlock2, sizeof( FileBlock2 ), Result2 );
  61.          EndFlag := Result2 <> sizeof( FileBlock2 );
  62.          repeat
  63.             FileBlock1 := FileBlock2;
  64.             Result1 := Result2;
  65.             FileBlock2 := ResultArray;
  66.             if not EndFlag then
  67.             begin
  68.                BlockRead( VF, FileBlock2, sizeof( FileBlock2 ), Result2 );
  69.                inc( BlockCount );
  70.                EndFlag := Result2 <> sizeof( FileBlock2 );
  71.             end else BlkDone := True;
  72.             for i := 1 to Result1 do
  73.             begin
  74.                if SearchArray[1] = FileBlock1[i] then
  75.                begin
  76.                   BlkOfs := i-1;
  77.                   SearchResult := true;
  78.                   for j := 1 to SearchLen do
  79.                   begin
  80.                      if i+j-1 <= Result1 then
  81.                      begin
  82.                         if SearchArray[j] = FileBlock1[i+j-1] then
  83.                            ResultArray[j] := FileBlock1[i+j-1] else
  84.                            begin
  85.                               SearchResult := false;
  86.                               j := SearchLen;
  87.                            end;
  88.                      end else
  89.                         if SearchArray[j] = FileBlock2[i+j-257] then
  90.                            ResultArray[j] := FileBlock2[i+j-257] else
  91.                            begin
  92.                               SearchResult := false;
  93.                               j := SearchLen;
  94.                            end;
  95.                   end;
  96.                   if SearchResult then
  97.                   begin
  98.                      for j := SearchLen+1 to sizeof( ResultArray ) do
  99.                         if i+j-1 <= Result1
  100.                            then ResultArray[j] := FileBlock1[i+j-1]
  101.                            else ResultArray[j] := FileBlock2[i+j-257];
  102.                      i := Result1;
  103.                   end;
  104.                end;
  105.             end;
  106.          until BlkDone or SearchResult;
  107.          if SearchResult then
  108.          begin
  109.             writeln( 'Search string found in file block ', BlockCount,
  110.                ' beginning at byte offset ', BlkOfs, ' ...' );
  111.             writeln;
  112.             if FileType = Unknown then
  113.                FileType := TestBlock( ResultArray,
  114.                                       sizeof( ResultArray ) );
  115.             case FileType of
  116.                  Hex : ListHex( ResultArray, sizeof( ResultArray ), BlkOfs );
  117.                Ascii : ListAscii( ResultArray, sizeof( ResultArray ) );
  118.             end;
  119.          end else writeln( '"', SearchStr, '" not found in ', FN );
  120.          close( VF );
  121.          window( 1, 1, 80, 25 );
  122.       end else writeln( Fn, ' invalid file name!' );
  123.    end;
  124.  
  125. procedure Viewer.FileOpen;
  126.    var
  127.       VF : file;      Ch : char;
  128.       Result, CrtX, CrtY : word;
  129.       EndFlag : boolean;
  130.       FileBlock : DataBlock;
  131.    begin
  132.       BlockCount := 0;
  133.       XOrg := X1;
  134.       YOrg := Y1;
  135.       LineLen := X2;
  136.       LineCnt := Y2;
  137.       FileType := Unknown;
  138.       assign( VF, Fn );
  139.       {$I-} reset( VF, 1 ); {$I+}
  140.       if IOresult = 0 then
  141.       begin
  142.          window( X1, Y1, X1+X2-1, Y1+Y2-1 );
  143.          writeln;
  144.          EndFlag := false;
  145.          repeat
  146.             BlockRead( VF, FileBlock, sizeof( FileBlock ), Result );
  147.             inc( BlockCount );
  148.             EndFlag := Result <> sizeof( FileBlock );
  149.             if FileType = Unknown then
  150.                FileType := TestBlock( FileBlock, Result );
  151.             case FileType of
  152.                  Hex : ListHex( FileBlock, Result, 0 );
  153.                Ascii : ListAscii( FileBlock, Result );
  154.             end;
  155.             if not EndFlag then
  156.             begin
  157.                CrtX := WhereX;    CrtY := WhereY;
  158.                if WhereY = LineCnt then
  159.                begin   writeln;
  160.                        dec( CrtY );  end;
  161.                gotoxy( 1, 1 );    clreol;
  162.                write(' Viewing: ', FN );
  163.                gotoxy( 1, LineCnt );   clreol;
  164.                write(' Press (+) to continue, (Enter) to exit: ');
  165.                Ch := ReadKey;     EndFlag := Ch <> '+';
  166.                gotoxy( 1, LineCnt );   clreol;
  167.                gotoxy( CrtX, CrtY );
  168.             end;
  169.          until EndFlag;
  170.          close( VF );
  171.          sound( 440 ); delay( 100 );
  172.          sound( 220 ); delay( 100 ); nosound;
  173.          window( 1, 1, 80, 25 );
  174.       end else writeln( Fn, ' invalid file name!' );
  175.    end;
  176.  
  177. function Viewer.TestBlock;
  178.    var
  179.       i : integer;
  180.    begin
  181.       FileType := Ascii;
  182.       for i := 1 to Count do
  183.          if not FileBlock[i] in NoPrnSet+PrintSet then
  184.             FileType := Hex;
  185.       TestBlock := FileType;
  186.    end;
  187.  
  188. procedure Viewer.ListHex;
  189.    const
  190.       HexStr: string[16] = '0123456789ABCDEF';
  191.    var
  192.       i, j, k : integer;
  193.    begin
  194.       k := 1;
  195.       repeat
  196.          write(' ');
  197.          j := (BlockCount-1) * sizeof( FileBlock ) + ( k - 1 ) + Ofs;
  198.          for i := 3 downto 0 do
  199.             write( HexStr[ j shr (i*4) AND $0F + 1 ] );
  200.          write(': ');
  201.          for i := 1 to 16 do
  202.          begin
  203.             if k <= Count then
  204.                write( HexStr[ FileBlock[k] shr 4 + 1 ],
  205.                       HexStr[ FileBlock[k] AND $0F + 1 ], ' ' )
  206.                else write( '  ' );
  207.             inc( k );
  208.             if( i div 4 = i / 4 ) then write(' ');
  209.          end;
  210.          for i := k-16 to k-1 do
  211.          if i <= Count then
  212.             if FileBlock[i] in PrintSet+ExtenSet
  213.                then write( chr( FileBlock[i] ) )
  214.                else write('.');
  215.          writeln;
  216.       until k >= Count;
  217.    end;
  218.  
  219. procedure Viewer.ListAscii;
  220.    var
  221.       i : integer;
  222.    begin
  223.       for i := 1 to Count do
  224.       begin
  225.          write( chr( FileBlock[i] ) );
  226.          if WhereX > LineLen then writeln;
  227.          if WhereY >= LineCnt then
  228.          begin
  229.             writeln;
  230.             gotoxy( 1, LineCnt-1 );
  231.          end;
  232.       end;
  233.    end;
  234.  
  235. {=============== end Viewer object ==============}
  236.  
  237. var
  238.    FileFind : Finder;
  239. begin
  240.    clrscr;
  241.    FileFind.Search( ParamStr(0),    { file to search }
  242.                     'Press any key',           { search string  }
  243.                     1, 1, 80, 25 );            { display window }
  244.    gotoxy( 1, 25 );   clreol;
  245.    write( 'Press any key to continue: ');
  246.    while not KeyPressed do;
  247. end.